home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / ResProc.bas < prev    next >
BASIC Source File  |  1997-06-14  |  3KB  |  78 lines
  1. Attribute VB_Name = "MResProc"
  2. Option Explicit
  3.  
  4. Function ResTypeProc(ByVal hModule As Long, ByVal lpszType As Long, _
  5.                      frm As Form) As Long
  6.     ResTypeProc = True      ' Always return True
  7.     If lpszType <= 65535 Then
  8.         ' Enumerate resources by ID
  9.         Call EnumResourceNamesID(hModule, lpszType, _
  10.                                  AddressOf ResNameProc, frm)
  11.     Else
  12.         ' Enumerate resources by string name
  13.         Call EnumResourceNamesStr(hModule, PointerToString(lpszType), _
  14.                                   AddressOf ResNameProc, frm)
  15.     End If
  16. End Function
  17.  
  18. Function ResNameProc(ByVal hModule As Long, ByVal lpszType As Long, _
  19.                      ByVal lpszName As Long, frm As Form) As Long
  20.     Dim sType As String, sName As String
  21.     ResNameProc = True      ' Always return True
  22.     If lpszName <= 65535 Then
  23.         sName = Format$(lpszName, "00000")
  24.     Else
  25.         sName = PointerToString(lpszName)
  26.     End If
  27.     If lpszType <= 65535 Then
  28.         sType = ResourceIdToStr(lpszType)
  29.     Else
  30.         sType = PointerToString(lpszType)
  31.     End If
  32.     If frm.chkFilter = vbChecked Then
  33.         If Not ValidateResource(hModule, sName, sType) Then Exit Function
  34.     End If
  35.     frm.lstResource.AddItem sName & "   " & sType
  36. End Function
  37.  
  38.  
  39. Function ValidateResource(hMod As Long, ByVal sName As String, _
  40.                           ByVal sType As String) As Boolean
  41.  
  42.     Dim i As Integer, hRes As Long
  43.  
  44.     ' Extract resource ID and type
  45.     If Left$(sName, 1) = "0" Then sName = "#" & Left$(sName, 5)
  46.     
  47.     Select Case UCase$(sType)
  48.     Case "CURSOR", "GROUP_CURSOR", "GROUP CURSOR"
  49.         hRes = LoadImage(hMod, sName, IMAGE_CURSOR, 0, 0, 0)
  50.         If hRes Then ValidateResource = True
  51.         Call DeleteObject(hRes)
  52.     Case "BITMAP"
  53.         hRes = LoadBitmap(hMod, sName)
  54.         If hRes Then ValidateResource = True
  55.         Call DeleteObject(hRes)
  56.     Case "ICON", "GROUP_ICON", "GROUP ICON"
  57.         hRes = LoadImage(hMod, sName, IMAGE_ICON, 0, 0, 0)
  58.         If hRes Then ValidateResource = True
  59.         Call DeleteObject(hRes)
  60.     Case "STRING", "STRINGTABLE"
  61.         hRes = FindResourceStrId(hMod, sName, RT_STRING)
  62.         If hRes Then ValidateResource = True
  63.         Call FreeResource(hRes)
  64.     Case "WAVE", "FONTDIR", "FONT", "DIALOG", "ACCELERATOR", _
  65.          "VERSION", "MENU", "AVI"
  66.         ' Always accept these
  67.         ValidateResource = True
  68.     Case Else
  69.         hRes = FindResourceStrStr(hMod, sName, sType)
  70.         If hRes Then ValidateResource = True
  71.         Call FreeResource(hRes)
  72.     End Select
  73.     
  74. End Function
  75.  
  76.  
  77.  
  78.